home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir27
/
equatev5.zip
/
EQUATE.BAS
next >
Wrap
BASIC Source File
|
1994-05-07
|
9KB
|
337 lines
REM Equate v5.0 PDS 7.1 BASIC source.
DECLARE FUNCTION Instrng% (Temp$, Temp2$)
DECLARE FUNCTION BinaryToDecimal# (B$)
REM Boolean operator truth table:
REM Value | Value of operator
REM of | X X X X X
REM | NOT AND OR XOR EQV IMP
REM X Y | X Y Y Y Y Y
REM -------------------------------------
REM T T | F T T F T T
REM T F | F F T T F F
REM F T | T F T T F T
REM F F | T F F F T T
DECLARE SUB Equate (Temp#)
DECLARE SUB Parse1 (Temp#)
DECLARE SUB Parse2 (Temp#)
DECLARE SUB Parse3 (Temp#)
DECLARE SUB Parse4 (Temp#)
DECLARE SUB Parse5 (Temp#)
DECLARE SUB Parse6 (Temp#)
DECLARE SUB Quantity (Temp$, Temp#, Temp2#)
DECLARE SUB Read.Token ()
DEFINT A-Z
COMMON SHARED Token AS INTEGER, Token.Index AS INTEGER
COMMON SHARED Out2 AS STRING, Strng AS STRING
REM (in order of precedence)
REM Comparitive operators:
REM > greater than
REM < less than
REM = equal to
REM # not equal to
REM Boolean operators:
REM & AND
REM | OR
REM ! NOT
REM ~ XOR
REM @ IMP
REM % EQV
REM Relational operators:
REM + plus
REM - minus/negation
REM * multiply
REM / divide
REM ^ exponent
REM ? modulo
REM Signature operators:
REM ABS(x) - absolute value of x
REM ATN(x) - arctangent of x
REM COS(x) - cosine of x
REM EXP(x) - e raised to the xth
REM FIX(x) - truncated decimal from x
REM INT(x) - largest integer equal to x
REM LOG(x) - natural logarithm of x
REM RND(x) - random number between 1 and x
REM SGN(x) - sign of x
REM SIN(x) - sine of x
REM SQR(x) - square root of x
REM TAN(x) - tangent of x
REM Quantity operators:
REM ( quantity
REM [ quantity
REM { quantity
REM Octal number: <numeric>O
REM starts with a number, for example: 019O
REM Hexidecimal number: <numeric>H
REM starts with a number, for example: 07FH
REM Binary number: <numeric>B
REM such as: 1011B
PRINT "Equate. Equation parser v4.0"
DO
PRINT "Enter Q to quit."
PRINT "Input equation to parse:"
INPUT Out2
Out2 = UCASE$(Out2)
IF Out2 = "Q" THEN
EXIT DO
END IF
CALL Equate(Var#)
PRINT Out2; " equals "; Var#
LOOP
END
FUNCTION BinaryToDecimal# (B$)
Bit = 0
Value# = 0
FOR L = LEN(B$) TO 1 STEP -1
IF MID$(B$, L, 1) = "1" THEN
Value# = Value# + 2 ^ Bit
END IF
Bit = Bit + 1
NEXT
BinaryToDecimal# = Value#
END FUNCTION
' routine to pre-parse input equation, and call recursive parser
SUB Equate (Temp#)
Temp# = False
Token.Index = 1
CALL Read.Token
CALL Parse1(Temp#)
END SUB
FUNCTION Instrng (Temp$, Temp2$)
IF LEN(Temp2$) = 0 THEN
Instrng = 0
ELSE
Instrng = INSTR(Temp$, Temp2$)
END IF
END FUNCTION
' starts parsing recursively in this routine. operator precedence order.
SUB Parse1 (Temp#)
CALL Parse2(Temp#)
Token.Parsed$ = Strng
WHILE Instrng("<>=#", Token.Parsed$)
CALL Read.Token
CALL Parse2(Temp2#)
CALL Quantity(Token.Parsed$, Temp#, Temp2#)
Token.Parsed$ = Strng
WEND
END SUB
SUB Parse2 (Temp#)
CALL Parse3(Temp#)
Token.Parsed$ = Strng
WHILE Instrng("&|!~@%", Token.Parsed$)
CALL Read.Token
CALL Parse3(Temp2#)
CALL Quantity(Token.Parsed$, Temp#, Temp2#)
Token.Parsed$ = Strng
WEND
END SUB
SUB Parse3 (Temp#)
CALL Parse4(Temp#)
Token.Parsed$ = Strng
WHILE Instrng("+-", Token.Parsed$)
CALL Read.Token
CALL Parse4(Temp2#)
CALL Quantity(Token.Parsed$, Temp#, Temp2#)
Token.Parsed$ = Strng
WEND
END SUB
SUB Parse4 (Temp#)
CALL Parse5(Temp#)
Token.Parsed$ = Strng
WHILE Instrng("*/", Token.Parsed$)
CALL Read.Token
CALL Parse5(Temp2#)
CALL Quantity(Token.Parsed$, Temp#, Temp2#)
Token.Parsed$ = Strng
WEND
END SUB
SUB Parse5 (Temp#)
CALL Parse6(Temp#)
Token.Parsed$ = Strng
WHILE Instrng("^?", Token.Parsed$)
CALL Read.Token
CALL Parse6(Temp2#)
CALL Quantity(Token.Parsed$, Temp#, Temp2#)
Token.Parsed$ = Strng
WEND
END SUB
SUB Parse6 (Temp#)
Token.Parsed$ = Strng
IF Instrng("([{", Token.Parsed$) THEN
CALL Read.Token
CALL Parse1(Temp#)
CALL Read.Token
EXIT SUB
END IF
CALL Quantity(Token.Parsed$, Temp#, Temp2#)
END SUB
' routine to apply equation symbol on two variables
SUB Quantity (Token.Parsed$, Temp#, Temp2#)
SELECT CASE Token
CASE 1
SELECT CASE Token.Parsed$
CASE "+"
Temp# = Temp# + Temp2#
CASE "-"
Temp# = Temp# - Temp2#
CASE "/"
Temp# = Temp# / Temp2#
CASE "*"
Temp# = Temp# * Temp2#
CASE "^"
Temp# = Temp# ^ Temp2#
CASE "?"
Temp# = Temp# MOD Temp2#
CASE "<"
Temp# = Temp# < Temp2#
CASE ">"
Temp# = Temp# > Temp2#
CASE "="
Temp# = Temp# = Temp2#
CASE "#"
Temp# = Temp# <> Temp2#
CASE "&"
Temp# = Temp# AND Temp2#
CASE "|"
Temp# = Temp# OR Temp2#
CASE "!"
Temp# = NOT Temp2#
CASE "~"
Temp# = Temp# XOR Temp2#
CASE "@"
Temp# = Temp# IMP Temp2#
CASE "%"
Temp# = Temp# EQV Temp2#
END SELECT
CASE 2
Token.Type$ = RIGHT$(Token.Parsed$, 1)
SELECT CASE Token.Type$
CASE "b", "B"
Temp# = BinaryToDecimal#(LEFT$(Token.Parsed$, LEN(Token.Parsed$) - 1))
CASE "h", "H"
Temp# = CDBL(VAL("&H" + Token.Parsed$))
CASE "o", "O"
Temp# = CDBL(VAL("&O" + Token.Parsed$))
CASE ELSE
Temp# = CDBL(VAL(Token.Parsed$))
END SELECT
CALL Read.Token
CASE 3
SELECT CASE Token.Parsed$
CASE "PI"
Temp# = 3.14159
CALL Read.Token
CASE "E"
Temp# = 2.718
CALL Read.Token
CASE "RND"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = CDBL(RND * Temp2# + 1)
CASE "ABS"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = ABS(Temp2#)
CASE "SGN"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = SGN(Temp2#)
CASE "SQR"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = SQR(Temp2#)
CASE "INT"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = INT(Temp2#)
CASE "FIX"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = FIX(Temp2#)
CASE "TAN"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = TAN(Temp2#)
CASE "ATN"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = ATN(Temp2#)
CASE "SIN"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = SIN(Temp2#)
CASE "COS"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = COS(Temp2#)
CASE "EXP"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = EXP(Temp2#)
CASE "LOG"
CALL Read.Token
CALL Parse1(Temp2#)
CALL Read.Token
Temp# = LOG(Temp2#)
END SELECT
END SELECT
END SUB
' gets next equation symbol in string, or next number, or constant mnemonic.
' counts index value of place in parse string, returns type of next symbol.
SUB Read.Token
Strng = ""
IF INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) THEN
Token = 1
Strng = MID$(Out2, Token.Index, 1)
Token.Index = Token.Index + 1
EXIT SUB
END IF
IF MID$(Out2, Token.Index, 1) >= "0" AND MID$(Out2, Token.Index, 1) <= "9" THEN
WHILE INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) = False
Strng = Strng + MID$(Out2, Token.Index, 1)
Token.Index = Token.Index + 1
WEND
Token = 2
EXIT SUB
END IF
IF MID$(Out2, Token.Index, 1) = "." THEN
WHILE INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) = False
Strng = Strng + MID$(Out2, Token.Index, 1)
Token.Index = Token.Index + 1
WEND
Token = 2
EXIT SUB
END IF
IF MID$(Out2, Token.Index, 1) >= "A" AND MID$(Out2, Token.Index, 1) <= "Z" THEN
WHILE INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) = False
Strng = Strng + MID$(Out2, Token.Index, 1)
Token.Index = Token.Index + 1
WEND
Token = 3
EXIT SUB
END IF
END SUB